home *** CD-ROM | disk | FTP | other *** search
/ MacHack 1999 / MacHack 1999.toast / The Hacks / YRTP / cgi-bin / webparser.pl
Perl Script  |  1999-06-25  |  3KB  |  131 lines
  1. #!/usr/bin/perl
  2.  
  3. print "Content-type: text/html\n\n";
  4. use LWP::Simple;
  5. require 'lock.pl';
  6.  
  7. # YRTP: the Perl bit
  8.  
  9. # P.D. Magnus
  10. # June 1999
  11.  
  12.  
  13.  
  14.  
  15. # get the query
  16. $line = $ENV{'QUERY_STRING'}."&";
  17. $line =~ s/%([a-fA-F0-9]{2})/chr(hex($1))/ge;
  18.  
  19. # parse the query
  20. SWITCH: for ($line) {
  21.     # determine the url
  22.     /url=(.+?)&/ ? ($urline = $1) : ($urline = "");
  23.     # determine the cue type
  24.     $jump = (/cue=jump/);
  25. }
  26.  
  27. if ($urline eq "") {$urline = "http://www.fecundity.com/";}
  28. if (!($urline =~ m|http:|i)) {$urline = "http://".$urline;}
  29.  
  30. PAGE: for (get $urline) {
  31.  
  32.   # this bit underwrites a really gruddy mechanism for converting relative
  33.   # to absolute url's-- here it figures out the root
  34.     $root = $urline;
  35.     if (($root =~ m|.*\x31htm|) || ($root =~ m|.*\x31pl|)) {
  36.       $root =~ s|(.*)/.+|$1|;
  37.     } else {
  38.       $root .= '/';
  39.     }
  40.     
  41.   # doctor the url
  42.     $urline =~ s|http:|yrtp:|i;
  43.  
  44.   # check for frames
  45.     if (m|<frame|i) {
  46.       s|NOFRAMES.*/NOFRAMES||gsi;
  47.       # absolutize links
  48.       s|SRC\s*=\s*"(?:http://)*(.*?)"|src = "webparser.pl?url=$root/$1&cue=jump"|gi;
  49.       if (!$jump) {s|cue=jump|cue=delay|g};
  50.       s|(?=<src = "webparser.pl?url=.*?)\x2F(?=.*?&)|%2F|g;
  51.       # doctor title
  52.       s|<TITLE>.*</TITLE>|<title>$urline</title>|gi;
  53.       # print out the altered page
  54.       print $_;
  55.       last PAGE;
  56.     }
  57.     
  58.   # convert to lower-case
  59.     $_ = lc;
  60.   
  61.   # tabulate links
  62.     @links = ("http://www.fecundity.com/codeweb");
  63.     push @links, m|href="(.*?)"|g;
  64.   # absolutize
  65.     foreach (@links) {
  66.       if (m|http:|) {
  67.         s|http://||;
  68.       } else {
  69.         $_ = $root.'/'.$_;
  70.       }
  71.     }
  72.     
  73.   # eliminate title
  74.     s|title.*/title||gs;
  75.   # include images with alt's
  76.     s|<img.*?alt="(.+?)".*?\Q>\E|img_$1_|g;
  77.   # convert links
  78.     s|<a.*?\Q>\E|L|g;
  79.     s|</a\Q>\E|M|g;
  80.   # convert special characters
  81.     s|"||g;
  82.     s|&|and|g;
  83.     s| |_|g;
  84.   # headlines
  85.     s|<h1>|X|g;
  86.     s|<h2>|Y|g;
  87.     s|<h3>|Z|g;
  88.     s|<h5>|W|g;
  89.     s|</h\d>|N|g;
  90.   # remaining tags
  91.     s|<.*?\Q>\E||gs;
  92.   # shuck out whitespace
  93.     s|\W||g;
  94.   # convert numbers
  95.     s|(\d+)|A$1j|g;
  96.     for ($i = 1; $i < 10; $i++) {
  97.       $j = chr ($i + 96);
  98.       s|$i|$j|g;
  99.     }
  100.     s|0|k|g;
  101.   # output the java-ized file with the appropriate data inside
  102.   (open (INFILE, $ENV{'DOCUMENT_ROOT'}.'/codeweb/rawcode'.($jump?'_j':'').'.html')) || die;
  103.   &lock(INFILE,0);
  104.   $line = <INFILE>;
  105.   print $line;
  106.   print "<TITLE>".$urline."</TITLE>\n";
  107.     
  108.   do {
  109.     $line = <INFILE>;
  110.     print $line;
  111.   } until ($line =~ m|Signal Code|);
  112.  
  113.   # spit the output
  114.   $line = qq{var output = '$_';\n};
  115.   $line =~ s|''|'B'|;
  116.   print $line;
  117.   # spit the links
  118.   print qq{var outlink = new Array();\n};
  119.   for($i=0; $i<$#links; $i++) {
  120.     print qq{outlink[$i] = '$links[$i]';\n};
  121.   }
  122.  
  123.   do  {
  124.     $line = <INFILE>;
  125.     print $line;
  126.   } until ($line =~ m|<!-- Never|);
  127.  
  128.   &unlock(INFILE);
  129.   close (INFILE);
  130. }
  131.